home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.000 / gcl-1 / gcl-1.0 / cmpnew / fasdmacros.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1994-05-07  |  1.9 KB  |  82 lines
  1.  
  2.  
  3. (defstruct (fasd (:type vector))
  4.   stream
  5.   table
  6.   eof
  7.   direction
  8.   package
  9.   index
  10.   filepos
  11.   table_length
  12.   evald_forms ; list of forms eval'd. (load-time-eval)
  13.   )
  14.  
  15. (defvar *fasd-ops*
  16. '(  d_nil         ;/* dnil: nil */
  17.   d_eval_skip    ;    /* deval o1: evaluate o1 after reading it */
  18.   d_delimiter    ;/* occurs after d_listd_general and d_new_indexed_items */
  19.   d_enter_vector ;     /* d_enter_vector o1 o2 .. on d_delimiter  make a cf_data with
  20.           ;  this length.   Used internally by gcl.  Just make
  21.           ;  an array in other lisps */
  22.   d_cons        ; /* d_cons o1 o2: (o1 . o2) */
  23.   d_dot         ;
  24.   d_list    ;/* list* delimited by d_delimiter d_list,o1,o2, ... ,d_dot,on
  25.         ;for (o1 o2       . on)
  26.         ;or d_list,o1,o2, ... ,on,d_delimiter  for (o1 o2 ...  on)
  27.           ;*/
  28.   d_list1   ;/* nil terminated length 1  d_list1o1   */
  29.   d_list2   ; /* nil terminated length 2 */
  30.   d_list3
  31.   d_list4
  32.   d_eval
  33.   d_short_symbol
  34.   d_short_string
  35.   d_short_fixnum
  36.   d_short_symbol_and_package
  37.   d_bignum
  38.   d_fixnum
  39.   d_string
  40.   d_objnull
  41.   d_structure
  42.   d_package
  43.   d_symbol
  44.   d_symbol_and_package
  45.   d_end_of_file
  46.   d_standard_character
  47.   d_vector
  48.   d_array
  49.   d_begin_dump
  50.   d_general_type
  51.   d_sharp_equals ;              /* define a sharp */
  52.   d_sharp_value
  53.   d_sharp_value2
  54.   d_new_indexed_item
  55.   d_new_indexed_items
  56.   d_reset_index
  57.   d_macro
  58.   d_reserve1
  59.   d_reserve2
  60.   d_reserve3
  61.   d_reserve4
  62.   d_indexed_item3 ;      /* d_indexed_item3 followed by 3bytes to give index */
  63.   d_indexed_item2  ;      /* d_indexed_item2 followed by 2bytes to give index */
  64.   d_indexed_item1 
  65.   d_indexed_item0    ;  /* This must occur last ! */
  66. ))
  67.  
  68. (defmacro put-op (op str)
  69.   `(write-byte ,(or (position op *fasd-ops*)
  70.             (error "illegal op")) ,str))
  71.  
  72. (defmacro put2 (n str)
  73.   `(progn  (write-bytei ,n 0 ,str)
  74.        (write-bytei  ,n 1 ,str)))
  75.   
  76. (defmacro write-bytei (n i str)
  77.   `(write-byte (the fixnum (ash (the fixnum ,n) >> ,(* i 8))) ,str))
  78.   
  79.  
  80. (provide 'FASDMACROS)
  81.  
  82.